home *** CD-ROM | disk | FTP | other *** search
/ UpTime Volume 2 #2 / utv2n2s2.d64 / app't calendar (.txt) < prev    next >
Commodore BASIC  |  2022-08-28  |  9KB  |  275 lines
  1. 1 if a=0 then print"";:poke 53281,0:poke 53280,0
  2. 22 if a=0 then a=1:load"cal.obj",8,1
  3. 25 clr:dimd$(42)
  4. 30 dn$=""
  5. 40 rt$=""
  6. 41 dimy$(5):fori=1to5:ready$(i):next
  7. 42 data 1,9,8,8,"[213]p[212]ime"
  8. 43 dimm$(15):fori=1to15:readm$(i):next
  9. 44 data " [202]anuary ","[198]ebruary ","  [205]arch  "
  10. 45 data "  [193]pril  ","   [205]ay   ","  [202]une   "
  11. 46 data "  [202]uly   "," [193]ugust  ","[211]eptember"
  12. 47 data " [207]ctober ","[206]ovember ","[196]ecember "
  13. 48 data " [213]p[212]ime  ","         "," [210]estart "
  14. 50 dimmnth$(12),maxday(12),days(31)
  15. 52 fori=1to12:readmnth$(i),maxday(i):next
  16. 54 data "[202]anuary",31,"[198]ebruary",29,"[205]arch",31
  17. 56 data"[193]pril",30,"[205]ay",31,"[202]une",30
  18. 58 data"[202]uly",31,"[193]ugust",31,"[211]eptember",30
  19. 60 data"[207]ctober",31,"[206]ovember",30,"[196]ecember",31
  20. 62 dimc$(5):fori=1to5:readc$(i):next
  21. 64 data" [197]nter [221]"," [204]oad  [221]"," [211]ave  [221]","[210]estart[221]"," [213]p[212]ime "
  22. 66 dimw$(7):fori=0to6:readw$(i):next
  23. 68 data"[211]unday","[205]onday","[212]uesday","[215]ednesday","[212]hursday","[198]riday","[211]aturday"
  24. 80 printchr$(14);chr$(8);
  25. 100 gosub9200
  26. 110 printtab(8)"[196]aily data record keeper"
  27. 115 printtab(8)"(c)1988 [194]arbara [211]chulak"
  28. 120 print""tab(9)"[176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]"
  29. 130 printtab(9)"[221][159] [201]nstructions [[217]/[206]] [146][221]"
  30. 135 printtab(9)"[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]"
  31. 140 printtab(14)"[150][176][192][192][192][192][192][192][192][192][192][174]"
  32. 142 printtab(14)"[150][221][146]         [221]"
  33. 144 printtab(14)"[150][221][146]   [158][172] [146]    [150][221]"
  34. 146 printtab(14)"[150][221][146]    [158] [146]    [150][221]"
  35. 148 printtab(14)"[150][221][146]    [158] [146]    [150][221]"
  36. 150 printtab(14)"[150][221][146]   [158][175][175][175][146]   [150][221]"
  37. 152 printtab(14)"[150][221][146]         [221]"
  38. 154 printtab(14)"[150][173][192][192][192][192][192][192][192][192][192][189]"
  39. 185 print"[155] [208]ublished by [211]oftdisk [208]ublishing, [201]nc.";
  40. 187 poke 198,0
  41. 188 getk$:ifk$=""then188
  42. 190 ifk$="y"thengosub10000:goto 200
  43. 195 if k$<>"n" then 188
  44. 200 print"[147]":ff=0:gosub9200
  45. 205 print"[154]"spc(5)"[211]elect year greater than 1752"
  46. 210 r=8:c=11:gosub9000
  47. 215 print"[154][176][192][174][176][192][174][176][192][174][176][192][174][153][176][192][192][192][192][192][192][174]"
  48. 220 printtab(11)"[154][221] [221][221] [221][221] [221][221] [221][153][221]      [221]"
  49. 225 printtab(11)"[154][173][192][189][173][192][189][173][192][189][173][192][189][153][173][192][192][192][192][192][192][189]"
  50. 226 gosub9600
  51. 230 r=9:c=12:gosub9000
  52. 235 fori=1to5:print""y$(i)"";:next
  53. 240 x=1:r=9:c=12:poke 198,0
  54. 245 gosub9000:print""y$(x)
  55. 250 getk$
  56. 251 ifk$=chr$(13)andx=5then sys 8*4096+4
  57. 252 ifk$=chr$(13)then300
  58. 255 ifk$=""thenx=x+1:c=c+3:ifx>5thenx=1:c=12
  59. 260 ifk$="[157]"thenx=x-1:c=c-3:ifx<1thenx=5:c=24
  60. 261 k=asc(y$(x))
  61. 265 ifk$="[145]"thenk=asc(y$(x)):k=k+1:ifk>57thenk=48
  62. 270 ifk$=""thenk=asc(y$(x)):k=k-1:ifk<48thenk=57
  63. 272 ifx<5theny$(x)=chr$(k)
  64. 275 gosub9000:print"[146]"y$(x):goto245
  65. 300 yr$="":fori=1to4:yr$=yr$+y$(i):next:yr=val(yr$):ff=yr:y1$=yr$
  66. 305 ifff<1753then200
  67. 318 gosub9200
  68. 319 print"[154]"spc(18)yr$
  69. 320 r=3:c=0:gosub9000
  70. 322 fori=1to4
  71. 325 printtab(4)"[176][192][192][192][192][192][192][192][192][192][174][176][192][192][192][192][192][192][192][192][192][174][176][192][192][192][192][192][192][192][192][192][174]"
  72. 330 printtab(4)"[221]         [221][221]         [221][221]         [221]"
  73. 335 printtab(4)"[173][192][192][192][192][192][192][192][192][192][189][173][192][192][192][192][192][192][192][192][192][189][173][192][192][192][192][192][192][192][192][192][189]":next
  74. 337 printtab(4)"[153][176][192][192][192][192][192][192][192][192][192][174][176][192][192][192][192][192][192][192][192][192][174][176][192][192][192][192][192][192][192][192][192][174]"
  75. 338 printtab(4)"[221]         [221][221]         [221][221]         [221]"
  76. 339 printtab(4)"[173][192][192][192][192][192][192][192][192][192][189][173][192][192][192][192][192][192][192][192][192][189][173][192][192][192][192][192][192][192][192][192][189]"
  77. 340 r=4:c=0:gosub9000
  78. 342 fori=1to15step3
  79. 345 printtab(5)"[150]"m$(i)"";m$(i+1)""m$(i+2)
  80. 350 print:print:next
  81. 355 gosub9100
  82. 400 x=1:r=4:c=5
  83. 401 gosub9000:print"[150]"m$(x)
  84. 405 getk$
  85. 407 if k$="[140]" then sys 8*4096+4
  86. 410 ifk$=chr$(13)andk=14then405
  87. 411 ifk$=chr$(13)andx=13then sys 8*4096+4
  88. 412 ifk$=chr$(13)andx=15then200
  89. 413 ifk$=chr$(13)andx<13then500
  90. 415 ifk$=""thenx=x+1:c=c+11:ifc>27thenc=c-11:x=x-1
  91. 420 ifk$="[157]"thenx=x-1:c=c-11:ifc<5thenc=c+11:x=x+1
  92. 430 ifk$="[145]"thenx=x-3:r=r-3:ifx<1thenx=x+3:r=r+3
  93. 440 ifk$=""thenx=x+3:r=r+3:ifx>15thenx=x-3:r=r-3
  94. 490 gosub9000:print"[146]"m$(x):goto401
  95. 500 gosub9200
  96. 501 dt$=mn$(x)+" "+yr$:print"[154]"tab((40-len(dt$))/2)dt$:mn=x:ff=ff+x:mo=x
  97. 505 print
  98. 510 printtab(9)"[176][192][192][178][192][192][178][192][192][178][192][192][178][192][192][178][192][192][178][192][192][174]"
  99. 512 printtab(9)"[221][160][160][221][160][160][221][160][160][221][160][160][221][160][160][221][160][160][221][160][160][221]"
  100. 516 fori=1to6
  101. 518 printtab(9)"[171][192][192][219][192][192][219][192][192][219][192][192][219][192][192][219][192][192][219][192][192][179]"
  102. 520 printtab(9)"[221][150]  [146][221][150]  [146][221][150]  [146][221][150]  [146][221][150]  [146][221][150]  [146][221][150]  [146][221]"
  103. 522 next
  104. 524 printtab(9)"[173][192][192][177][192][192][177][192][192][177][192][192][177][192][192][177][192][192][177][192][192][189]"
  105. 526 print"[153]"tab(10)"[211] [205] [212] [215] [212] [198] [211] "
  106. 527 gosub9100
  107. 530 gosub6000
  108. 540 gosub1600
  109. 550 r=7:c=10:x=1:poke 198,0
  110. 560 gosub9000:print"[150]"d$(x)
  111. 565 getk$
  112. 567 if k$="[140]" then sys 8*4096+4
  113. 570 ifk$=chr$(13)andd$(x)<>"  "then600
  114. 575 ifk$=""thenx=x+1:c=c+3:ifc>28thenx=x-1:c=c-3
  115. 580 ifk$="[157]"thenx=x-1:c=c-3:ifc<10thenc=c+3:x=x+1
  116. 585 ifk$="[145]"thenx=x-7:r=r-2:ifr<7thenr=r+2:x=x+7
  117. 590 ifk$=""thenx=x+7:r=r+2:ifr>17thenr=r-2:x=x-7
  118. 595 gosub9000:print"[146][150]"d$(x):goto560
  119. 600 f$=left$(mn$(mo),3)+d$(x)+y1$
  120. 605 print"[147]";:sys49609:rem fill color
  121. 610 gosub900
  122. 615 gosub9700
  123. 626 gosub2000
  124. 630 getk$
  125. 631 ifk$=chr$(13)then700
  126. 635 ifk$=""thengosub9000:print"[154]"c$(x):x=x+1:c=c+8:ifx>5thenx=1:c=0
  127. 640 ifk$="[157]"thengosub9000:print"[154]"c$(x):x=x-1:c=c-8:ifx<1thenx=5:c=32
  128. 645 ifk$=""ork$="[157]"thengosub9000:print"[155]"left$(c$(x),7)
  129. 650 goto630
  130. 700 ifx=5thensys 8*4096+4
  131. 705 ifx=4then200
  132. 710 ifx=3thengosub3000:goto615
  133. 715 ifx=2thengosub2000:goto615
  134. 720 print"[150] [193]ppointment [195]alendar         [198]1 = [205]enu "
  135. 730 sys49152
  136. 735 gosub9700:goto630
  137. 740 :
  138. 900 print"[146][176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]";
  139. 905 print"[221]                                      [221]";
  140. 906 print"[171][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][179]";
  141. 910 fori=1to20:print"[221]                                      [221]";:next
  142. 920 print"[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]":poke2023,125:poke56295,1
  143. 925 dt$=w$(days(val(d$(x))))+" "+mn$(mo)+" "+d$(x)+", "+y1$:print
  144. 926 remprint""tab((40-len(dt$))/2);dt$
  145. 927 r=2:c=(40-len(dt$))/2:gosub9000:printdt$
  146. 930 return
  147. 1600 d=1:f=0:print"";
  148. 1605 forx=1toeom
  149. 1610 if(day(1)=0)then1650
  150. 1615 iff=1then1650
  151. 1620 f=1:b=day(1)
  152. 1630 forx1=1tob:print"[150]  ";:d$(d)="  ":d=d+1
  153. 1640 next
  154. 1650 x$=str$(x):iflen(x$)>2thenx$=right$(x$,2)
  155. 1655 d$(d)=x$:d=d+1
  156. 1660 print"[150]";x$;"";
  157. 1670 ifpeek(211)>29thenprint:print"";
  158. 1680 next
  159.